home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / TransSkel.cpt / ManyWind.pas < prev    next >
Pascal/Delphi Source File  |  1987-03-06  |  7KB  |  262 lines
  1. {    ManyWind TransSkel demonstration}
  2.  
  3. {    This application allows up to twenty windows to be created at once,}
  4. {    with the New item under the File menu.  The name of each window}
  5. {    appears under the Windows menu (which is not created until at least}
  6. {    one window exists).  Selecting the window name from the Windows menu}
  7. {    brings the window to the front.  For every window created, Skel is}
  8. {    told to create a new handler.  If the window's close box is clicked,}
  9. {    the handler removes the window name from the Windows menu, disposes}
  10. {    of the window, and removes itself from the window handler list.  If}
  11. {    the window was the last window, the Windows menu handler removes}
  12. {    itself from the menu handler list.}
  13.  
  14. {    When the first window is created, a Color menu also appears.  This}
  15. {    allows the color of the content region of the frontmost window to}
  16. {    be changed.  It goes away when the last window is closed.}
  17.  
  18. {    To quit, select Quit from the File menu or type command-Q.}
  19.  
  20. {    ManyWind demonstrates dynamic window and menu creation and disposal.}
  21. {    It also shows how handler procedures may be shared among handlers}
  22. {    for different windows.}
  23.  
  24. {    The project should include this file, TransSkelpas (or a project}
  25. {    built from TransSkelpas), and MacTraps and MacPasLib.}
  26.  
  27. {    28 June 1986        Paul DuBois}
  28. {    7 January 1987 Owen Hartnett, Ωhm Software Co.    }
  29.  
  30. PROGRAM ManyWind;
  31.  
  32.     USES
  33.         TransSkelPas;
  34.  
  35.     CONST
  36.         maxWind = 20;    { maximum number of windows existing at once }
  37.  
  38.         aMenuNum = 1;    { Apple menu }
  39.         fMenuNum = 2;        { File menu }
  40.         wMenuNum = 3;        { Windows menu }
  41.         cMenuNum = 4;        { Color menu }
  42.  
  43.         new = 1;
  44.         quit = 3;
  45.  
  46.         cWhite = 1;
  47.         cLtGray = 2;
  48.         cGray = 3;
  49.         cDkGray = 4;
  50.         cBlack = 5;
  51.  
  52.     VAR
  53.         fileMenu, windowMenu, colorMenu : MenuHandle;
  54.  
  55.         windCount : integer;    { number of currently existing windows }
  56.         windNum : longint;    { id of last window created }
  57.  
  58.     PROCEDURE MakeWindow;
  59.     forward;
  60.     PROCEDURE DoWClose;
  61.     forward;
  62.  
  63.     PROCEDURE DoWUpdate;
  64.  
  65.         VAR
  66.             thePort : GrafPtr;
  67.  
  68.     BEGIN
  69.         GetPort(thePort);
  70.         EraseRect(thePort^.portRect);    { repaint w/background pattern }
  71.     END;
  72.  
  73.     PROCEDURE DoMClobber (theMenu : MenuHandle);
  74.  
  75.     BEGIN
  76.         DisposeMenu(theMenu);
  77.     END;
  78.  
  79.     PROCEDURE DoFileMenu (item : integer);
  80.  
  81.     BEGIN
  82.         CASE item OF
  83.             quit : 
  84.                 SkelWhoa;        { tell SkelMain to quit }
  85.             new : 
  86.                 MakeWindow;    { make a new window }
  87.         END;
  88.     END;
  89.  
  90. {    Dispose of window.  Skel makes sure the port is pointing to the}
  91. {    appropriate window, so this procedure can determine which window}
  92. {    is to be disposed, of without being told explicitly.}
  93.  
  94.  
  95.     PROCEDURE DoWClobber;
  96.  
  97.         VAR
  98.             thePort : GrafPtr;
  99.  
  100.     BEGIN
  101.         GetPort(thePort);                { grafport of window to dispose of }
  102.         DisposeWindow(WindowPtr(thePort));
  103.     END;
  104.  
  105. {    Change the background pattern of the frontmost window.  Ignore}
  106. {    if the front window is a DA window.}
  107.  
  108.     PROCEDURE DoColorMenu (item : integer);
  109.  
  110.         VAR
  111.             w : WindowPeek;
  112.             w2 : WindowPtr;
  113.  
  114.     BEGIN
  115.         w := WindowPeek(FrontWindow);
  116.         SetPort(WindowPtr(w));                {*** Fixed bug in original windows    }
  117.         IF w^.windowKind >= 0 THEN             { front is not DA window }
  118.             BEGIN
  119.                 CASE item OF
  120.                     cWhite : 
  121.                         BackPat(white);
  122.                     cLtGray : 
  123.                         BackPat(ltGray);
  124.                     cGray : 
  125.                         BackPat(gray);
  126.                     cDkGray : 
  127.                         BackPat(dkGray);
  128.                     cBlack : 
  129.                         BackPat(black);
  130.                 END;
  131.                 w2 := WindowPtr(w);
  132.                 EraseRect(w2^.portRect);
  133.             END;
  134.     END;
  135.  
  136.  
  137.     PROCEDURE DoWindowMenu (item : integer);
  138.  
  139.         VAR
  140.             iTitle, wTitle : Str255;
  141.             w : WindowPeek;
  142.  
  143.     BEGIN
  144.         GetItem(windowMenu, item, iTitle);     { get window name }
  145.         w := WindowPeek(FrontWindow);
  146.         WHILE w <> NIL DO
  147.             BEGIN
  148.                 GetWTitle(WindowPtr(w), wTitle);
  149.                 IF EqualString(iTitle, wTitle, false, true) THEN
  150.                     BEGIN
  151.                         SelectWindow(WindowPtr(w));
  152.                         w := NIL;
  153.                     END;
  154.                 IF w <> NIL THEN
  155.                     w := w^.nextWindow;
  156.             END;
  157.     END;
  158.  
  159. {    Make new window.  Locate at (100, 100) if no other windows, else}
  160. {    offset slightly from front window.  The window title is the next}
  161. {    window number (1, 2, 3, ...).  If this is the first window, create}
  162. {    the Windows and Color menus.  Add the window title as the last item}
  163. {    of the Windows menu.}
  164.  
  165. {    If the maximum window count has been reached, disable New in the}
  166. {    File menu.}
  167.  
  168.     PROCEDURE MakeWindow;
  169.  
  170.         VAR
  171.             w : WindowPtr;
  172.             r, r2 : Rect;
  173.             s : Str255;
  174.  
  175.     BEGIN
  176.         SetRect(r, 0, 0, 200, 150);
  177.         w := FrontWindow;
  178.         IF w = NIL THEN
  179.             OffsetRect(r, 100, 100)
  180.         ELSE
  181.             BEGIN
  182.                 r2 := w^.portBits.bounds;
  183.                 OffSetRect(r, 20 - r2.left, 20 - r2.top);
  184.                 IF (r.left > 480) OR (r.top > 300) THEN    { keep on screen }
  185.                     OffsetRect(r, 40 - r.left, 40 - r.top);
  186.             END;
  187.         WindNum := windnum + 1;
  188.         NumToString(windNum, s);
  189.         w := NewWindow(NIL, r, s, true, documentProc, WindowPtr(-1), true, 0);
  190.         SkelWindow(w, NIL, NIL, @DoWUpdate, NIL, @DoWClose, @DoWclobber, NIL, false);
  191.         windCount := windCount + 1;
  192.         IF windCount - 1 = 0 THEN     { if first window, create new menus }
  193.             BEGIN
  194.                 colorMenu := NewMenu(cMenuNum, 'Color');
  195.                 AppendMenu(colorMenu, 'White;Light Gray;Gray; Dark Gray; Black');
  196.                 SkelMenu(colorMenu, @DoColorMenu, @DoMClobber);
  197.                 windowMenu := NewMenu(wMenuNum, 'Windows');
  198.                 SkelMenu(windowMenu, @DoWindowMenu, @DoMClobber);
  199.             END;
  200.         AppendMenu(windowMenu, s);
  201.         IF windCount = maxWind THEN
  202.             DisableItem(fileMenu, new);
  203.     END;
  204.  
  205. {    Mouse was clicked in close box.  Remove the window handler (which}
  206. {    causes the window to be disposed of), and delete the window title}
  207. {    from the Windows menu.  If the window was the last one, delete the}
  208. {    Windows and Color menus entirely.}
  209.  
  210. {    Skel makes sure the port is pointing to the appropriate window, so}
  211. {    this procedure can determine which window had its close box clicked,}
  212. {    without being told explicitly.}
  213.  
  214.     PROCEDURE DoWClose;
  215.  
  216.         VAR
  217.             thePort : GrafPtr;
  218.             m : MenuHandle;
  219.             i, mItems : integer;
  220.             iTitle, wTitle : Str255;
  221.  
  222.     BEGIN
  223.         GetPort(thePort);            { grafport of window to be closed }
  224.         GetWTitle(WindowPtr(thePort), wTitle);
  225.         SkelRmveWind(WindowPtr(thePort));
  226.         windCount := windCount - 1;
  227.         IF windCount = 0 THEN
  228.             BEGIN
  229.                 SkelRmveMenu(windowMenu);    { last window - clobber menus }
  230.                 SkelRmveMenu(colorMenu);
  231.             END
  232.         ELSE
  233.             BEGIN    { just take out of menu }
  234.                 m := NewMenu(wMenuNum, 'Windows');
  235.                 mItems := CountMItems(windowMenu);
  236.                 FOR i := 1 TO mItems DO
  237.                     BEGIN
  238.                         GetItem(windowMenu, i, iTitle);
  239.                         IF NOT EqualString(iTitle, wTitle, false, true) THEN
  240.                             AppendMenu(m, iTitle);
  241.                     END;
  242.                 SkelRmveMenu(windowMenu);    { remove old Windows menu }
  243.                 windowMenu := m;                { and install new one }
  244.                 SkelMenu(windowMenu, @DoWindowMenu, @DoMClobber);
  245.             END;
  246.         EnableItem(fileMenu, new);    { can always create at least one more now }
  247.     END;
  248.  
  249.  
  250. BEGIN
  251.  
  252.     WindCount := 0;
  253.     WindNum := 0;
  254.     SkelInit;                                            { initialize }
  255.     SkelApple('', NIL);                                { handle desk accessories }
  256.     fileMenu := NewMenu(fMenuNum, 'File');        { make File menu handler }
  257.     AppendMenu(fileMenu, 'New/N;(-;Quit/Q');
  258.     SkelGrowBounds(NIL, 50, 10, 500, 300);
  259.     SkelMenu(fileMenu, @DoFileMenu, @DoMClobber);
  260.     SkelMain;                                        { loop 'til Quit selected }
  261.     SkelClobber;                                    { clean up }
  262. END.